home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 3032.ZIP / RLIB20.ZIP / RL_MARKR.PRG < prev    next >
Text File  |  1989-08-23  |  11KB  |  287 lines
  1. * Function: MARKREC
  2. * Author..: Richard Low
  3. * Syntax..: MARKREC(top, left, bottom, right, output, markkey, field, colors)
  4. * Notes...: Function for cursoring through a box-menu selection of records
  5. *           from the currently selected database, and marking the records
  6. *           to work with by pressing a designated key (default = F9)
  7. * Returns.: A character string of selected record numbers, each eight digits
  8. *           long, delimited with a comma ",", or a null string if Escape
  9. *           was pressed.
  10. *
  11. * Assumes.: Expects to be passed the following parameters:
  12. *
  13. *           p1 = exp<N> - top row of the box contents
  14. *           p2 = exp<N> - top left column of box contents
  15. *           p3 = exp<N> - bottom row of box contents
  16. *           p4 = exp<N> - bottom right column of box contents
  17. *           p5 = exp<C> - field list to be displayed in box
  18. *           p6 = exp<N> - ASCII key value of mark/unmark key (default = F9)
  19. *           p7 = exp<C> - character field name to add to mark list
  20. *           p8 = exp<A> - color settings
  21. *
  22. * Example: records = MARKED( 6, 40, 18, 78, "Fnm+' '+Lnm", -4,  )
  23. *
  24. FUNCTION MARKREC
  25. PARAMETERS p_top,p_left,p_bottom,p_right,p_output,p_markkey,p_mkfield,p_colors
  26. PRIVATE f_lkey, f_lastrec, f_marked, f_count, f_markdata, f_marklen,;
  27.         f_position, f_standard, f_highlite, f_seekstr
  28.  
  29. *-- verify first 5 parameters given are correct type
  30. IF TYPE('p_top')   + TYPE('p_left') + TYPE('p_bottom') +;
  31.    TYPE('p_right') + TYPE('p_output') != 'NNNNC'
  32.    RETURN 0
  33. ENDIF
  34.  
  35. p_markkey = IF( TYPE('p_markkey') = 'N', p_markkey, -8 )                 && INKEY() value of F9 key
  36. p_mkfield = IF( TYPE('p_mkfield') = 'C', p_mkfield, ' ' )
  37. p_mkfield = IF( EMPTY(p_mkfield), 'STR(RECNO(),8,0)', p_mkfield )        && default mark field is Record number
  38.  
  39. *-- save length of a marked data item, plus 1 for the trailing comma
  40. f_marklen = LEN(&p_mkfield) + 1                                          
  41.  
  42.  
  43. in_color = SETCOLOR()
  44.  
  45. *-- use <color array> if it is an array AND it has at least 5 elements
  46. IF IF( TYPE('p_colors') = 'A', IF(LEN(p_colors) >= 5, .T., .F.) , .F. )
  47.    f_display  = p_colors[1]
  48.    f_bright   = p_colors[2]
  49.    f_reverse  = p_colors[3]
  50.    f_revblink = p_colors[4]
  51. ELSE
  52.    f_display  = SETCOLOR()
  53.    f_bright   = BRIGHT(in_color)
  54.    f_reverse  = GETPARM(2,in_color)
  55.    f_revblink = BRIGHT(f_reverse)                                        && puts a '+' at end of forground part
  56.    f_revblink = STUFF( f_revblink, AT('+',f_revblink), 1, '*')           && replace '+' with '*' to make it blinking
  57. ENDIF
  58.  
  59. SETCOLOR(f_display)
  60.  
  61. IF LEN(&p_output) != p_right - p_left + 1                             && see if width of output is different from width of box
  62.    IF LEN(&p_output) > p_right - p_left + 1                                    && if wider than box
  63.       p_output = 'SUBSTR(' + p_output + ',1,p_right - p_left + 1)'             && shorten it
  64.    ELSE
  65.       padding = SPACE( p_right - p_left + 1 - LEN(&p_output) )                 && otherwise, pad it with spaces
  66.       p_output = p_output + " + padding"                              && pad output with spaces
  67.    ENDIF
  68. ENDIF
  69.  
  70. f_lastrec = RECNO()
  71. @ p_top,p_left SAY ' '                                                && put normal video blank, otherwise scroll get reverse
  72. SCROLL( p_top, p_left, p_bottom, p_right, 0 )                         && clear inside of box to be filled with records
  73. mrow = p_top                                                          && set up first row for display
  74. DO WHILE mrow <= p_bottom .AND. (.NOT. EOF())                         && fill box with available records
  75.    @ mrow,p_left SAY &p_output                                        && from database in normal video
  76.    mrow = mrow + 1
  77.    SKIP
  78. ENDDO
  79. mrow = p_top                                                          && set back to first row
  80. GOTO f_lastrec
  81.  
  82. f_seekstr  = ""
  83. f_marked   = ""                                                        && initialize string to store record nums
  84. f_standard = .F.                                                       && easily identify operation of the MarkDisplay procedure
  85. f_highlite = .T.
  86.  
  87. DO WHILE .T.
  88.    DO MarkDisplay WITH f_highlite
  89.    f_lkey = INKEY(0)
  90.    DO MarkDisplay WITH f_standard
  91.    f_lastrec = RECNO()
  92.  
  93.    DO CASE
  94.       CASE f_lkey = 5
  95.          *-- Up Arrow
  96.          f_seekstr = ""
  97.          SKIP -1
  98.          IF BOF()
  99.             GOTO f_lastrec
  100.             LOOP
  101.          ENDIF
  102.          mrow = mrow - 1
  103.          IF mrow < p_top
  104.             SCROLL( p_top, p_left, p_bottom, p_right, -1 )
  105.             mrow = p_top
  106.          ENDIF
  107.  
  108.       CASE f_lkey = 24
  109.          *-- Down Arrow
  110.          f_seekstr = ""
  111.          SKIP
  112.          IF EOF()
  113.             GOTO f_lastrec
  114.             LOOP
  115.          ENDIF
  116.          mrow = mrow + 1
  117.          IF mrow > p_bottom
  118.             SCROLL( p_top, p_left, p_bottom, p_right, 1 )
  119.             mrow = p_bottom
  120.          ENDIF
  121.  
  122.       CASE f_lkey = 27
  123.          *-- Escape Key
  124.          f_marked = ""
  125.          EXIT
  126.  
  127.       CASE f_lkey = 13
  128.          *-- Enter Key
  129.          *-- if no records are marked
  130.          IF LEN(f_marked) = 0
  131.             *-- this is the only one selected, so add it
  132.             f_marked = &p_mkfield + ","
  133.          ENDIF
  134.          DO MarkDisplay WITH f_highlite
  135.          EXIT
  136.  
  137.       CASE f_lkey = p_markkey
  138.          f_seekstr = ""
  139.          f_markdata = &p_mkfield + ","                                && extract data and add trailing comma
  140.          f_position = AT( f_markdata, f_marked )
  141.          IF f_position = 0                                            && not found in string
  142.             f_marked = f_marked + f_markdata                          && mark/add to string
  143.          ELSE
  144.             f_marked = STUFF(f_marked, f_position, f_marklen, "")     && delete from string
  145.          ENDIF
  146.  
  147.       CASE f_lkey = 18
  148.          *-- Page Up
  149.          f_seekstr = ""
  150.          f_count = 1
  151.          DO WHILE f_count < p_bottom - p_top + 1 .AND. (.NOT. BOF())
  152.             DO MarkDisplay WITH f_standard
  153.             SKIP -1
  154.             IF BOF()
  155.                GO TOP
  156.                EXIT
  157.             ENDIF
  158.             mrow = mrow - 1
  159.             IF mrow < p_top
  160.                SCROLL( p_top, p_left, p_bottom, p_right, -1 )
  161.                mrow = p_top
  162.             ENDIF
  163.             DO MarkDisplay WITH f_highlite
  164.             f_count = f_count + 1
  165.          ENDDO
  166.  
  167.       CASE f_lkey = 3
  168.          *-- Page Down
  169.          f_seekstr = ""
  170.          f_count = 1
  171.          DO WHILE f_count < p_bottom - p_top + 1 .AND. (.NOT. EOF())
  172.             DO MarkDisplay WITH f_standard
  173.             SKIP
  174.             IF EOF()
  175.                GO BOTTOM
  176.                EXIT
  177.             ENDIF
  178.             mrow = mrow + 1
  179.             IF mrow > p_bottom
  180.                SCROLL( p_top, p_left, p_bottom, p_right, 1 )
  181.                mrow = p_bottom
  182.             ENDIF
  183.             DO MarkDisplay WITH f_highlite
  184.             f_count = f_count + 1
  185.          ENDDO
  186.  
  187.       CASE f_lkey = 1
  188.          *-- Home Key
  189.          f_seekstr = ""
  190.          GO TOP
  191.          DO MarkRefresh WITH mrow
  192.  
  193.       CASE f_lkey = 6
  194.          *-- End Key
  195.          f_seekstr = ""
  196.          f_lkey = 0
  197.          DO WHILE f_lkey = 0 .AND. (.NOT. EOF())
  198.             DO MarkDisplay WITH f_standard
  199.             SKIP
  200.             IF EOF()
  201.                GO BOTTOM
  202.                EXIT
  203.             ENDIF
  204.             mrow = mrow + 1
  205.             IF mrow > p_bottom
  206.                SCROLL( p_top, p_left, p_bottom, p_right, 1 )
  207.                mrow = p_bottom
  208.             ENDIF
  209.             DO MarkDisplay WITH f_highlite
  210.             f_lkey = INKEY()
  211.          ENDDO
  212.  
  213.       CASE f_lkey > 31 .AND. f_lkey < 127                                 && printable character range
  214.          IF EMPTY(INDEXKEY(0))                                            && if no index is controlling
  215.             LOOP                                                          && skip this proc
  216.          ENDIF
  217.          f_seekstr = f_seekstr + UPPER(CHR(f_lkey))
  218.          SEEK f_seekstr                                                   && seek upper case first
  219.          IF EOF()
  220.             SEEK LOWER(f_seekstr)                                         && try finding lower case match
  221.             IF EOF()
  222.                f_seekstr = ''
  223.                GOTO f_lastrec
  224.                ?? CHR(7)
  225.                LOOP
  226.             ENDIF
  227.          ENDIF
  228.          f_lastrec = RECNO()
  229.          DO MarkRefresh WITH mrow
  230.  
  231.    ENDCASE
  232. ENDDO
  233. SETCOLOR(in_color)
  234. RETURN f_marked
  235.  
  236.  
  237. *----------------------------------------------------------------------------
  238. * Procedure: MarkDisplay
  239. * Notes....: Sub-routine to display the <p_output> in the proper color setting.
  240. * Parameter: Logical True|False indicates if the output display is currently
  241. *            selected or not.  Selected output is displayed in one of two
  242. *            colors different from unselected output.
  243. *
  244. *              Un-selected Un-marked - Standard setting   <f_display >
  245. *              Un-selected Marked    - Bright Standard    <f_bright  >
  246. *              Selected    Un-marked - Enhanced setting   <f_reverse >
  247. *              Selected    Marked    - Blinking Enhanced  <f_revblink>
  248. *----------------------------------------------------------------------------
  249. PROCEDURE MarkDisplay
  250. PARAMETER selected
  251. IF selected
  252.    SETCOLOR( IF( &p_mkfield + "," $ f_marked, f_revblink, f_reverse) )
  253. ELSE
  254.    SETCOLOR( IF( &p_mkfield + "," $ f_marked, f_bright,   f_display) )
  255. ENDIF
  256. @ mrow,p_left SAY &p_output
  257. RETURN
  258.  
  259.  
  260.  
  261. *----------------------------------------------------------------------------
  262. * Procedure: MarkRefresh
  263. * Notes....: Sub-procedure to refresh the entire display box from the current
  264. *            record.  After the display is complete, the record pointer is
  265. *            re-positioned to the incoming record pointer location.
  266. * Assumes..: The record pointer is positioned at the first record to be
  267. *            displayed on th first line of the box.
  268. * Parameter: Gets <mrow> as a parameter to ensure it can change its value.
  269. *----------------------------------------------------------------------------
  270. PROCEDURE MarkRefresh
  271. PARAMETER mrow
  272. PRIVATE inrec
  273. inrec = RECNO()
  274. mrow = p_top
  275. SETCOLOR(f_display)
  276. @ p_top,p_left SAY ' '
  277. SCROLL( p_top, p_left, p_bottom, p_right, 0 )
  278. DO WHILE mrow <= p_bottom .AND. (.NOT. EOF())
  279.    DO MarkDisplay WITH f_standard
  280.    mrow = mrow + 1
  281.    SKIP
  282. ENDDO
  283. mrow = p_top
  284. GOTO inrec
  285. RETURN
  286.  
  287.